Otherware/Otherware_1_SB_Development.iso/mac/developm/language/macberon.sit/MacOberon 2.4(0)/TickCounter.Mod

Oberon Text | 1991-10-17 | 3.9 KB | 101 lines

Syntax10.Scn.Fnt
MODULE TickCounter;    (* Michael Franz, 10.10.91 *)
        Installs a Task that will update a tick count which is displayed centered
        in a viewer.  Oberon Tasks even run in the background under MultiFinder
        but are activated less often.
            The tick count may be exported to the caret position by the usual
        CopyOver control-option combination.
            Great for demo purposes - the larger the font chosen, the better the
        effect.
        Position the Star Marker in this viewer (Enter on Keypad)
                Compiler.Compile *
                TickCounter.Open
    IMPORT
        SYSTEM, Display, Fonts, Oberon, Texts, TextFrames, Viewers, MenuViewers, Input;
    CONST
        Font="Helvetica24.Scn.Fnt";
    TYPE
        TickMsg=RECORD (Display.FrameMsg)    END;
        Frame=POINTER TO FrameDesc;
        FrameDesc=RECORD (Display.FrameDesc) END;
        W: Texts.Writer;
        ticks: LONGINT; countTask: Oberon.Task;
        pat: ARRAY 10 OF LONGINT; dx0, fontH: INTEGER;
    PROCEDURE* Tick;    (* Installed as an Oberon Task *)
        VAR t: LONGINT; M: TickMsg;
    BEGIN    SYSTEM.GET(16AH, t);
        IF    t#ticks    THEN    ticks:=t; Viewers.Broadcast(M)    END
    END Tick;
    PROCEDURE UpdateCounter(F: Frame);    (* Update Tick Count in Frame F *)
        VAR i: INTEGER; n: LONGINT; a: ARRAY 10 OF INTEGER; ch, X, Y: INTEGER;
    BEGIN
        IF    F.H > fontH    THEN    i:=0; n:=ticks;
            REPEAT    a[i]:=SHORT(n MOD 10); n:=n DIV 10; INC(i)    UNTIL    n=0;
            X:=F.X+(F.W-i*dx0) DIV 2; Y:=F.Y+(F.H-fontH) DIV 2;
            REPEAT    DEC(i); ch:=a[i]; Display.CopyPattern(Display.white, pat[ch], X, Y, Display.replace); INC(X, dx0)    UNTIL    i=0;
        END
    END UpdateCounter;
    PROCEDURE Export;    (* Copy Counter to Caret *)
        VAR M: Oberon.CopyOverMsg;
    BEGIN    Texts.WriteInt(W, ticks, 8); M.text:=TextFrames.Text(""); Texts.Append(M.text, W.buf);
        M.beg:=0; M.end:=M.text.len; Oberon.FocusViewer.handle(Oberon.FocusViewer, M)
    END Export;
    PROCEDURE Handle*(F: Display.Frame; VAR M: Display.FrameMsg);
        VAR keysum: SET; F1: Frame;
    BEGIN
        WITH    F: Frame    DO
            IF    M IS TickMsg    THEN    UpdateCounter(F)
            ELSIF    M IS Oberon.InputMsg    THEN
                WITH    M: Oberon.InputMsg    DO
                    IF    M.id = Oberon.track    THEN
                        IF    (M.X >= F.X) & (M.X < F.X+F.W) & (F.Y <= M.Y)    THEN    keysum:=M.keys;
                            Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, M.X, M.Y);
                            WHILE    M.keys # {}    DO    Input.Mouse(M.keys, M.X, M.Y); keysum:=keysum+M.keys;
                                Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, M.X, M.Y)
                            END;
                            IF    keysum={0, 1}    THEN    Export    END
                        END
                    END
                END
            ELSIF    M IS Oberon.ControlMsg    THEN
                WITH    M: Oberon.ControlMsg    DO
                    IF    M.id = Oberon.mark    THEN    Oberon.DrawCursor(Oberon.Pointer, Oberon.Star, M.X, M.Y)    END
                END
            ELSIF    M IS Oberon.CopyMsg    THEN
                WITH    M: Oberon.CopyMsg    DO    NEW(F1); F1^:=F^; M.F:=F1    END
            ELSIF    M IS MenuViewers.ModifyMsg    THEN
                WITH    M: MenuViewers.ModifyMsg    DO    F.H:=M.H; F.Y:=M.Y;
                    IF    M.H > 0    THEN    Display.ReplConst(Display.black, F.X, F.Y, F.W, F.H, Display.replace); UpdateCounter(F)    END
                END
            END
        END
    END Handle;
    PROCEDURE NewCountFrame(): Frame;
        VAR F: Frame;
    BEGIN    NEW(F); F.handle:=Handle; RETURN F
    END NewCountFrame;
    PROCEDURE NewCountTask(VAR T: Oberon.Task);
    BEGIN    NEW(T); T.safe:=FALSE; T.handle:=Tick; Oberon.Install(T)
    END NewCountTask;
    PROCEDURE Open*;
        VAR X, Y: INTEGER; V: Viewers.Viewer;
    BEGIN
        IF    countTask = NIL    THEN    NewCountTask(countTask)    END;
        Oberon.AllocateSystemViewer(Oberon.SystemTrack(0), X, Y);
        V:=MenuViewers.New(
            TextFrames.NewMenu("TickCounter", "System.Close System.Copy System.Grow TickCounter.Stop"),
            NewCountFrame(), TextFrames.menuH, X, Y)
    END Open;
    PROCEDURE Stop*;
    BEGIN    Oberon.Remove(countTask); countTask:=NIL
    END Stop;
    PROCEDURE InitTable;
        VAR fnt: Fonts.Font; i, x, y, w, h, dx: INTEGER;
    BEGIN    fnt:= Fonts.This(Font); i:=9;
        WHILE    i >= 0    DO    Display.GetChar(fnt.raster, CHR(ORD("0")+ i), dx, x, y, w, h, pat[i]); DEC(i)    END;
        dx0:=dx; fontH:=fnt.height
    END InitTable;
BEGIN
    Texts.OpenWriter(W); InitTable; NewCountTask(countTask)
END TickCounter.